home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / win / pascal / frameoh.exe / STATIC.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-02-12  |  8.1 KB  |  280 lines
  1.  
  2. {$A+}   { Align data }
  3. {$B-}   { Boolean evaluation }
  4. {$E+}   { 80x87 emulator }
  5. {$F-}   { Force FAR calls }
  6. {$G+}   { 80286 code }
  7. {$I-}   { I/O checking }
  8. {$K+}   { Smart Callbacks }
  9. {$N-}   { 80x87 code }
  10. {$O-}   { Overlays allowed }
  11. {$P-}   { Open parameters }
  12. {$T-}   { Typed pointers }
  13. {$V-}   { String VAR checking }
  14. {$W-}   { Windows stack frame for real mode }
  15. {$X+}   { Extended syntax }
  16.  
  17. {$IFDEF DEBUG}
  18.     {$D+}   { Debug information }
  19.     {$L+}   { Local symbols }
  20.     {$Q+}   { Overflow checking }
  21.     {$R+}   { Range checking }
  22.     {$S+}   { Stack checking }
  23.     {$Y+}   { Symbol reference information }
  24. {$ELSE}
  25.     {$D-}   { Debug information }
  26.     {$L-}   { Local symbols }
  27.     {$Q-}   { Overflow checking }
  28.     {$R-}   { Range checking }
  29.     {$S-}   { Stack checking }
  30.     {$Y-}   { Symbol reference information }
  31. {$ENDIF}
  32.  
  33. {$C Moveable Demandload Discardable} { Code Segment attributes }
  34.  
  35. {$M 8192,4096}
  36.  
  37. PROGRAM StaticTest;
  38.  
  39. {
  40.   Copyright (c) 1993 by Olaf He▀ (Hess), Munich, Germany.
  41.  
  42.   Please feel free to use this code in your own programs.
  43.   If you make $$$ with it ->> You have my ID!
  44.   If you find any bugs or do any changes to the source code that you find
  45.   generally useful please send me a message to my CompuServe account
  46.   100 031, 35 36.
  47.  
  48.   Thanks.
  49. }
  50.  
  51. {$R STATIC.RES}
  52.  
  53. {$D StaticTest by Olaf Hess}
  54.  
  55. USES WinTypes, WinProcs, OWindows, ODialogs, WinDos, CommDlg,
  56.      FrameDlg, Stat_Ids;
  57.  
  58. CONST
  59.     szAppName = 'StaticTest';
  60.     szClassName = 'StaticTestClass';
  61.  
  62. TYPE
  63.     TStaticApp = OBJECT (TApplication)
  64.         PROCEDURE InitMainWindow; VIRTUAL;
  65.     END; { TStaticApp }
  66.  
  67.     PStaticWindow = ^TStaticWindow;
  68.     TStaticWindow = OBJECT (TSteelDlgWnd)
  69.         pToStaticUp : PStaticUp;
  70.         pToStaticDown : PStaticDown;
  71.         pToFrameUp : PFrameUp;
  72.         pToFrameDown : PFrameDown;
  73.  
  74.         CONSTRUCTOR Init (AParent: PWindowsObject; ATitle: PChar);
  75.  
  76.         PROCEDURE SetupWindow; VIRTUAL;
  77.         PROCEDURE GetWindowClass (VAR AWndClass: TWndClass); VIRTUAL;
  78.         FUNCTION GetClassName : PChar; VIRTUAL;
  79.  
  80.         PROCEDURE wmCommand (VAR Msg: TMessage);
  81.             VIRTUAL wm_First + wm_Command;
  82.  
  83.         PROCEDURE idChooseFile (VAR Msg: TMessage);
  84.             VIRTUAL id_First + id_ChooseFile;
  85.     END; { TStaticWindow }
  86.  
  87. (* ---- *)
  88.  
  89. FUNCTION FileOpenHook (hDlgWin: hWnd; Msg, wParam: Word;
  90.                        lParam: LongInt) : Word; EXPORT;
  91. { Hook procedure for the common dialog file open dialog. Note that this
  92.   function has to be marked as EXPORT and that Smart Callbacks must be
  93.   enabled: $K+ }
  94.  
  95. BEGIN
  96.     FileOpenHook := 0; { Default processing }
  97.  
  98.     CASE Msg OF
  99.         wm_InitDialog : FileOpenHook := 1; { Don't pass through }
  100.  
  101.         wm_CtlColor :
  102.             BEGIN
  103.                 IF (NOT fDoColors) THEN Exit; { Enough colors? }
  104.  
  105.                 CASE HiWord (lParam) OF
  106.  
  107.                     CtlColor_Dlg :
  108.                         { Brush for the dialog background }
  109.                         FileOpenHook := hBackgroundBrush;
  110.  
  111.                     CtlColor_Edit,
  112.                     CtlColor_ListBox,
  113.                     CtlColor_ScrollBar,
  114.                     CtlColor_MsgBox,
  115.                     CtlColor_Static :
  116.                         BEGIN
  117.                             { Brush for the background }
  118.                             FileOpenHook := GetStockObject (LTGRAY_BRUSH);
  119.                             { Set the text background color }
  120.                             SetBkColor (wParam, rgbLightGray);
  121.                         END; { case CtlColor_Static }
  122.  
  123.                 END; { case }
  124.             END; { case wm_CtlColor }
  125.     END; { case }
  126. END; { FileOpenHook }
  127.  
  128. (* ---- *)
  129.  
  130. PROCEDURE TStaticApp.InitMainWindow;
  131. { Create the window object }
  132.  
  133. BEGIN
  134.     MainWindow := New (PStaticWindow, Init (NIL, 'MainDialog'));
  135. END; { TStaticApp.InitMainWindow }
  136.  
  137. (* ---- *)
  138.  
  139. CONSTRUCTOR TStaticWindow.Init (AParent: PWindowsObject; ATitle: PChar);
  140. { Initialize the window object }
  141.  
  142. BEGIN
  143.     INHERITED Init (AParent, ATitle); { Call ancestor }
  144.  
  145.     { Initialize the recessed/raised controls }
  146.     { Statics }
  147.     New (pToStaticUp, InitResource (@SELF, id_StaticUp, 25));
  148.     New (pToStaticDown, InitResource (@SELF, id_StaticDown, 25));
  149.     { Frames }
  150.     New (pToFrameUp, InitResource (@SELF, id_FrameUp));
  151.     New (pToFrameDown, InitResource (@SELF, id_FrameDown));
  152. END; { TStaticWindow.Init }
  153.  
  154. (* ---- *)
  155.  
  156. PROCEDURE TStaticWindow.SetupWindow;
  157. { Initialize the controls }
  158.  
  159. BEGIN
  160.     INHERITED SetupWindow; { Call ancestor }
  161.  
  162.     { Put some text into the static controls. Note the leading space. }
  163.     pToStaticUp^.SetText (' Raised static control');
  164.     pToStaticDown^.SetText (' Recessed static control');
  165. END; { TStaticWindow.SetupWindow }
  166.  
  167. (* ---- *)
  168.  
  169. PROCEDURE TStaticWindow.GetWindowClass (VAR AWndClass: TWndClass);
  170.  
  171. BEGIN
  172.     INHERITED GetWindowClass (AWndClass); { Vorfahre aufrufen }
  173. END; { TStaticWindow.GetWindowClass }
  174.  
  175. (* ---- *)
  176.  
  177. FUNCTION TStaticWindow.GetClassName : PChar;
  178.  
  179. BEGIN
  180.     GetClassName := szClassName;
  181. END; { TStaticWindow.GetClassName }
  182.  
  183. (* ---- *)
  184.  
  185. PROCEDURE TStaticWindow.wmCommand (VAR Msg: TMessage);
  186. { Quit program if user presses ESC }
  187.  
  188. BEGIN
  189.     IF (Msg.wParam = idCancel) THEN
  190.     BEGIN
  191.         PostMessage (hWindow, wm_Close, 0, 0);
  192.         Msg.Result := 0;
  193.     END { if }
  194.     ELSE INHERITED wmCommand (Msg);
  195. END; { TStaticWindow.wmCommand }
  196.  
  197. (* ---- *)
  198.  
  199. PROCEDURE TStaticWindow.idChooseFile (VAR Msg: TMessage);
  200. { User pressed the "Select a file" button }
  201.  
  202. CONST
  203.     DefExt = 'exe';
  204.     szFilter = 'Programs'#0'*.exe *.com *.bat *.pif'#0'All files'#0'*.*'#0#0;
  205.     cPathLen = 100;
  206.  
  207. VAR
  208.     pToOpenFN : POpenFileName;
  209.     pacFilter, pacFileName, pacFullFileName : PChar;
  210.     hWndEdit1, hWndEdit2 : hWnd;
  211.  
  212. BEGIN
  213.     New (pToOpenFN);
  214.     GetMem (pacFileName, cPathLen);
  215.     GetMem (pacFullFileName, cPathLen);
  216.  
  217.     { Es wird kein Dateiname ⁿbergeben }
  218.     lstrcpy (pacFileName,  '');
  219.     lstrcpy (pacFullFileName, '');
  220.  
  221.     pacFilter := szFilter;
  222.  
  223.     FillChar (pToOpenFN^, SizeOf (TOpenFileName), #0); { Fill structure }
  224.  
  225.  
  226.     WITH pToOpenFN^ DO
  227.     BEGIN { Initialize structure }
  228.         hInstance := System.hInstance; { Instance handle }
  229.         hWndOwner := hWindow; { Handle of parent window }
  230.         lpStrDefExt := DefExt; { Default extension }
  231.         lpStrFile := pacFullFileName; { Initial filename }
  232.         lpStrFilter := pacFilter; { The list with the extensions }
  233.         lpStrFileTitle := pacFileName; { Full filename including path }
  234.         lpStrTitle := 'Browse for a file'; { Dialog box title }
  235.         { Various flags }
  236.         Flags := ofn_FileMustExist OR ofn_HideReadOnly OR ofn_EnableHook;
  237.         lStructSize := SizeOf (TOpenFileName); { Size of data structure }
  238.         nFilterIndex := 1; { Select the first filter }
  239.         nMaxFile := cPathLen - 1; { Size of buffer }
  240.         lpfnHook := FileOpenHook; { Hook function. $K+ must be enabled!!! }
  241.     END; { with }
  242.  
  243.     IF (GetOpenFileName (pToOpenFN^)) THEN
  244.     BEGIN { Success }
  245.         hWndEdit1 := GetDlgItem (hWindow, id_EditUp);
  246.         hWndEdit2 := GetDlgItem (hWindow, id_EditDown);
  247.  
  248.         SetFocus (hWndEdit1);
  249.  
  250.         { Copy the filename into the parent window's edit controls }
  251.         SendMessage (hWndEdit1, wm_SetText, 0, LongInt (pacFileName));
  252.         SendMessage (hWndEdit2, wm_SetText, 0, LongInt (pacFileName));
  253.  
  254.         { Repaint the edit controls in the parent window in case that the
  255.           user moved the "Browse for a file" dialog. Without the call to
  256.           InvalidateRect the text in the edit controls won't get displayed
  257.           correctly IF the dialog box is over the edit controls. }
  258.         InvalidateRect (hWndEdit1, NIL, TRUE);
  259.         InvalidateRect (hWndEdit2, NIL, TRUE);
  260.     END; { if }
  261.  
  262.     Dispose (pToOpenFN);
  263.     FreeMem (pacFileName, cPathLen);
  264.     FreeMem (pacFullFileName, cPathLen);
  265. END; { TStaticWindow.idChooseFile }
  266.  
  267. (* ---- *)
  268.  
  269. VAR
  270.     StaticApp : TStaticApp;
  271.  
  272. BEGIN { StaticTest }
  273.     WITH StaticApp DO
  274.     BEGIN
  275.         Init (szAppName);
  276.         Run;
  277.         Done;
  278.     END; { with }
  279. END. { StaticTest }
  280.